home *** CD-ROM | disk | FTP | other *** search
/ ADA Programming Guide / ADA Programming Guide.iso / ada_gwu / pack.c < prev    next >
C/C++ Source or Header  |  1996-01-30  |  14KB  |  440 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9. /* pack.c: translation of pack.stl */
  10.  
  11. #define GEN
  12.  
  13. #include "hdr.h"
  14. #include "libhdr.h"
  15. #include "vars.h"
  16. #include "segment.h"
  17. #include "gvars.h"
  18. #include "ops.h"
  19. #include "type.h"
  20. #include "setp.h"
  21. #include "statp.h"
  22. #include "procp.h"
  23. #include "miscp.h"
  24. #include "maincasp.h"
  25. #include "genp.h"
  26. #include "gutilp.h"
  27. #include "gmiscp.h"
  28. #include "libp.h"
  29. #include "segmentp.h"
  30. #include "smiscp.h"
  31. #include "packp.h"
  32.  
  33. #ifdef MONITOR
  34. extern char MON_PACKAGE_NAME[33];
  35. #endif
  36.  
  37. extern Segment    CODE_SEGMENT, DATA_SEGMENT, DATA_SEGMENT_MAIN;
  38.  
  39.  
  40. /*
  41.  * Chapter 7: Packages
  42.  *  The only problem with packages is the possible presence of tasks
  43.  *  objects in the specification part and the point of their activation
  44.  *  as defined by the RM: on the 'begin' of the package body, if it
  45.  *  exists.
  46.  */
  47.  
  48. void gen_package(Node pack_node)                            /*;gen_package*/
  49. {
  50.     Tuple    tup;
  51.     Node    id_node, decl_node, private_node;
  52.     int     save_tasks_declared;
  53.     Tuple    save_subprog_specs;
  54.     Symbol    package_name;
  55.  
  56.     save_tasks_declared = TASKS_DECLARED;
  57.     TASKS_DECLARED      = FALSE;
  58.     save_subprog_specs  = SUBPROG_SPECS;
  59.     SUBPROG_SPECS       = tup_new(0);
  60.  
  61. #ifdef TRACE
  62.     if (debug_flag)
  63.         gen_trace_node("GEN_PACKAGE", pack_node);
  64. #endif
  65.  
  66.     id_node = N_AST1(pack_node);
  67.     decl_node = N_AST2(pack_node);
  68.     private_node = N_AST3(pack_node);
  69.     package_name = N_UNQ(id_node);
  70.  
  71.     next_local_reference(package_name);
  72.  
  73.     gen_kv(I_PUSH_IMMEDIATE, mu_word, int_const_null_task);
  74.     if (save_tasks_declared) {
  75.         gen_c(I_LINK_TASKS_DECLARED, "save current tasks_declared");
  76.         gen_ks(I_DECLARE, mu_word, package_name);
  77.     }
  78.     else {
  79.         gen_ks(I_DECLARE, mu_word, package_name);
  80.         /* mu_word? */
  81.         gen_ksc(I_POP, mu_word, package_name, "initialize tasks declared");
  82.     }
  83.  
  84.     compile(decl_node);
  85.     compile(private_node);
  86.  
  87.     if (TASKS_DECLARED || save_tasks_declared)
  88.         gen_s(I_POP_TASKS_DECLARED, package_name);
  89.  
  90.     /* needs body already checked by FE */
  91.     tup = tup_new(3);
  92.     tup[1] = (char *) TASKS_DECLARED;
  93.     tup[2] = (char *) 0;
  94.     tup[3] = (char *) tup_copy(SUBPROG_SPECS);
  95.     MISC(package_name) = (char *) tup;
  96.     /* insert warning check in case symbol not package  ds 9-8-85*/
  97.     if (!(NATURE(package_name) == na_package
  98.       || NATURE(package_name)==na_package_spec)) {
  99.         chaos("pack.c: genpack - setting MISC for symbol ");
  100.     }
  101.  
  102.     TASKS_DECLARED = save_tasks_declared;
  103.     SUBPROG_SPECS  = save_subprog_specs;
  104.  
  105. }
  106.  
  107. void gen_package_body(Node body_node)                    /*;gen_package_body*/
  108. {
  109.     /* Process package body that is not a library unit */
  110.  
  111.     Tuple    tup;
  112.     Symbol    package_name;
  113.     int save_tasks_declared;
  114.     Tuple    save_subprog_specs;
  115.     Node    id_node, decl_node, stmts_node, handler_node;
  116.  
  117. #ifdef TRACE
  118.     if (debug_flag)
  119.         gen_trace_node("GEN_PACKAGE_BODY", body_node);
  120. #endif
  121.  
  122.     id_node = N_AST1(body_node);
  123.     decl_node = N_AST2(body_node);
  124.     stmts_node = N_AST3(body_node);
  125.     handler_node = N_AST4(body_node);
  126.     package_name = N_UNQ(id_node);
  127.  
  128.     save_tasks_declared = TASKS_DECLARED;
  129.     tup = (Tuple) MISC(package_name);
  130.     TASKS_DECLARED = (tup != (Tuple)0) ? (int) tup[1] : FALSE;
  131.  
  132.     save_subprog_specs  = SUBPROG_SPECS;
  133.     /* Note that SUBPROG_SPECS now stored in 3rd MISC entry   ds 7-9-85*/
  134.     SUBPROG_SPECS = (tup != (Tuple)0) ? tup_copy((Tuple) tup[3]) : tup_new(0);
  135.  
  136.     /* trivial case: this is a dummy package body and no task declared in */
  137.     /*             the specification part. */
  138.     /*
  139.      *   if blk=[] and not TASKS_DECLARED then
  140.      *    TASKS_DECLARED := save_tasks_declared;
  141.      *    return;
  142.      *   end if;
  143.      */
  144.  
  145.     if (TASKS_DECLARED || save_tasks_declared) {
  146.         gen_ksc(I_PUSH, mu_word, package_name, "retrieve tasks_declared");
  147.         gen(I_LINK_TASKS_DECLARED);
  148.     }
  149.  
  150.     /*
  151.      *   if blk = [] then    $ dummy body, TASKS_DECLARED always TRUE
  152.      *    generate(I_ACTIVATE);
  153.      *   else
  154.      */
  155.     compile(decl_node);
  156.     if (TASKS_DECLARED) {
  157.         gen(I_ACTIVATE);
  158.     }
  159.     else if (save_tasks_declared) {
  160.         gen_sc(I_POP_TASKS_DECLARED, package_name, "discard one level");
  161.     }
  162.  
  163.     compile_body(OPT_NODE, stmts_node, handler_node, TRUE);
  164.     /*   end if; */
  165.  
  166.     TASKS_DECLARED = save_tasks_declared;
  167.     SUBPROG_SPECS  = save_subprog_specs;
  168. }
  169.  
  170. void unit_package_spec(Node pack_node)                    /*;unit_package_spec*/
  171. {
  172.     /*
  173.      * Compilation of a library package spec.
  174.      * As it is a compilation unit, there is no task link to be preserved
  175.      */
  176.  
  177.     Node    id_node, decl_node, private_node;
  178.     Symbol    package_name, package_proc;
  179.     Tuple    tup;
  180.     Tuple    local_reference_map_new();
  181.     Symbol package_tasks;
  182.  
  183. #ifdef TRACE
  184.     if (debug_flag)
  185.         gen_trace_node("UNIT_PACKAGE_SPEC", pack_node);
  186. #endif
  187.  
  188.     id_node = N_AST1(pack_node);
  189.     decl_node = N_AST2(pack_node);
  190.     private_node = N_AST3(pack_node);
  191.     package_name = N_UNQ(id_node);
  192.  
  193.     TASKS_DECLARED = FALSE;
  194.     CURRENT_LEVEL  = 1;
  195.     LAST_OFFSET      = -SFP_SIZE;
  196.     MAX_OFFSET      = 0;
  197.     /* TBSL: see if can free current local reference map before allocating
  198.      * new one    ds 23-may 
  199.      */
  200.     LOCAL_REFERENCE_MAP = local_reference_map_new();
  201.  
  202.     /* Create associated name for initialization proc for spec. */
  203.     /*package_proc           = package_name+'_spec';*/
  204.     package_proc = sym_new(na_procedure);
  205.     assoc_symbol_put(package_name, INIT_SPEC, package_proc);
  206.     new_symbol(package_proc, na_procedure, symbol_none, tup_new(0), (Symbol)0);
  207.     ORIG_NAME(package_proc) = ORIG_NAME(package_name);
  208. #ifdef MONITOR
  209.     strncpy( MON_PACKAGE_NAME, ORIG_NAME(package_name), 32 );
  210. #endif
  211.     generate_object(package_proc);
  212.     CURRENT_DATA_SEGMENT = select_entry(SELECT_DATA, package_proc, SLOTS_DATA);
  213.     CURRENT_CODE_SEGMENT = select_entry(SELECT_CODE, package_proc, SLOTS_CODE);
  214. #ifdef MACHINE_CODE
  215.     if (list_code) {
  216.         to_gen_int("       data slot #", CURRENT_DATA_SEGMENT);
  217.         to_gen_int("       code slot #", CURRENT_CODE_SEGMENT);
  218.         to_gen(" ");
  219.     }
  220. #endif
  221.     next_global_reference_r(package_proc, CURRENT_CODE_SEGMENT, 0);
  222.  
  223.     /* Create associated name for initialization of inner tasks.*/
  224.     /*package_tasks        = package_name+'_tasks';*/
  225.     package_tasks = sym_new(na_obj);
  226.     assoc_symbol_put(package_name, INIT_TASKS, package_tasks);
  227.     /* SETL version gives package_tasks signature with null tuple.
  228.     * This does not correspond to usual form of signature
  229.     * for na_obj, namely a node. Hence in C we set it to
  230.     * null pointer.
  231.     */
  232.     new_symbol(package_tasks, na_obj, symbol_none, (Tuple)0, 
  233.       (Symbol)package_tasks);
  234.     generate_object(package_tasks);
  235.     /* TBSL: see if byte is appropriate: 
  236.      * next_global_reference_word(package_tasks, [0]);
  237.      */
  238.     next_global_reference_word(package_tasks, 0);
  239.  
  240.     gen(I_LEAVE_BLOCK);
  241.     gen(I_RAISE);
  242.  
  243.     compile(decl_node);
  244.     compile(private_node);
  245.  
  246.     if (TASKS_DECLARED)
  247.         gen_s(I_POP_TASKS_DECLARED, package_tasks);
  248.     gen(I_ENTER_BLOCK);
  249.     gen(I_LEAVE_BLOCK);
  250.     MAX_OFFSET = offset_max(MAX_OFFSET, LAST_OFFSET);
  251.     /* calculate the size of local objects and don't assume it is zero 
  252.     * because it is a package spec. It will not be zero in the case of 
  253.     * nested packages.
  254.     */
  255.     gen_ic(I_DATA, MAX_OFFSET-SFP_SIZE, "Local variables");/*GBSL*/
  256.     gen(I_END);
  257.  
  258.     tup = tup_new(3);
  259.     tup[1] = (char *) TASKS_DECLARED;
  260.     tup[2] = (char *) SPECS_DECLARED;
  261.     tup[3] = (char *) SUBPROG_SPECS; /* note 3rd comp was formerly signature*/
  262.     MISC(package_name)       = (char *) tup;
  263.     CODE_SEGMENT_MAP = segment_map_put(CODE_SEGMENT_MAP, CURRENT_CODE_SEGMENT,
  264.       CODE_SEGMENT);
  265. #ifdef MONITOR
  266.     *MON_PACKAGE_NAME = '\0';
  267. #endif
  268. }
  269.  
  270. void unit_package_body(Node body_node)                    /*;unit_package_body*/
  271. {
  272.     /*
  273.      * Compilation of a library package body.
  274.      * As it is a compilation unit, there is no task link to be preserved
  275.      */
  276.  
  277.     Node    id_node, decl_node, stmts_node, handler_node;
  278.     Symbol    package_name, package_proc, name, temp_name;
  279.     Tuple    tup, stub_tup;
  280.     int        si;
  281.     Segment    stemplate;
  282.     struct    tt_subprog *tptr;
  283.     int        i, n, stub_cs; 
  284.     unsigned int patch_addr;
  285.     Stubenv    ev;
  286.     Tuple    local_reference_map_new();
  287.  
  288. #ifdef TRACE
  289.     if (debug_flag)
  290.         gen_trace_node("UNIT_PACKAGE_BODY", body_node);
  291. #endif
  292.  
  293.     id_node = N_AST1(body_node);
  294.     decl_node = N_AST2(body_node);
  295.     stmts_node = N_AST3(body_node);
  296.     handler_node = N_AST4(body_node);
  297.     package_name = N_UNQ(id_node);
  298.     tup = (Tuple) MISC(package_name);
  299.     TASKS_DECLARED = (tup != (Tuple)0) ? (int) tup[1] : FALSE;
  300.  
  301.     SUBPROG_SPECS = (tup != (Tuple)0) ? tup_copy((Tuple) tup[3]) : tup_new(0);
  302.  
  303.     /* trivial case: this is a dummy package body and no task declared in */
  304.     /* the specification part. If it is a subunit, we must generate it */
  305.     /* anyhow, as the corresponding call has been generated. */
  306.     /*
  307.      *   if blk=[] and not TASKS_DECLARED and not is_subunit(unit_name) then
  308.      *    return;
  309.      *   end if;
  310.      */
  311.  
  312.     /* Create associated name for proc. to elaborate body. */
  313.     /* package_proc           = package_name+'_body';*/
  314.     /* Only add the package_proc to GENERATED_OBJECTS if it is not
  315.      * a subunit because in the case of a subunit it already exists
  316.      * in the unit which contained the stub.
  317.      */
  318.     if (is_subunit(unit_name)) {
  319.         package_proc = assoc_symbol_get(package_name, INIT_BODY);
  320.     }
  321.     else {
  322.         package_proc = sym_new(na_procedure);
  323.         assoc_symbol_put(package_name, INIT_BODY, package_proc);
  324.         generate_object(package_proc);
  325.     }
  326.     NATURE   (package_proc) = na_procedure;
  327.     TYPE_OF  (package_proc) = symbol_none;
  328.     SIGNATURE(package_proc) = tup_new(0);
  329.     ORIG_NAME(package_proc) = ORIG_NAME(package_name);
  330. #ifdef MONITOR
  331.     strncpy( MON_PACKAGE_NAME, ORIG_NAME(package_name), 32 );
  332. #endif
  333.     CURRENT_DATA_SEGMENT = select_entry(SELECT_DATA, package_proc, SLOTS_DATA);
  334.     if (is_subunit(unit_name)) {
  335.         si = stub_numbered(unit_name);
  336.         stub_tup = (Tuple) stub_info[si];
  337.         ev = (Stubenv) stub_tup[2];
  338.         /*CURRENT_LEVEL     = STUB_ENV(unit_name)(10);*/
  339.         /* CURRENT_LEVEL = ev->ev_current_level; */
  340.         CURRENT_LEVEL = current_level_get(unit_name);
  341.         CURRENT_CODE_SEGMENT = select_entry(SELECT_CODE, package_proc,
  342.           SLOTS_CODE_BORROWED);
  343.         /* package_procedure object and template already generated */
  344.     }
  345.     else {
  346.         CURRENT_LEVEL       = 1;
  347.         CURRENT_CODE_SEGMENT = select_entry(SELECT_CODE, package_proc,
  348.           SLOTS_CODE);
  349.         next_global_reference_r(package_proc, CURRENT_CODE_SEGMENT, 0);
  350.     }
  351.     LAST_OFFSET           = -SFP_SIZE;
  352.     MAX_OFFSET           = 0;
  353.     /* TBSL: see if can free prior value of local reference map DS 23-may*/
  354.     LOCAL_REFERENCE_MAP = local_reference_map_new();
  355.     /* TBSL: see if can free current value of relay set */
  356.     RELAY_SET           = tup_new(0);
  357. #ifdef MACHINE_CODE
  358.     if (list_code) {
  359.         to_gen_int("       data slot # ", CURRENT_DATA_SEGMENT);
  360.         to_gen_int("       code slot # ", CURRENT_CODE_SEGMENT);
  361.         to_gen(" ");
  362.     }
  363. #endif
  364.     gen(I_LEAVE_BLOCK);
  365.     gen(I_RAISE);
  366.  
  367.     if (TASKS_DECLARED) {
  368.         gen_ks(I_PUSH, mu_word, assoc_symbol_get(package_name, INIT_TASKS));
  369.         gen(I_LINK_TASKS_DECLARED);
  370.     }
  371.  
  372.     compile(decl_node);
  373.     if (TASKS_DECLARED)
  374.         gen(I_ACTIVATE);
  375.  
  376.     compile_body(OPT_NODE, stmts_node, handler_node, FALSE);
  377.  
  378.     /*MAX_OFFSET max= abs LAST_OFFSET;*/
  379.     MAX_OFFSET = offset_max(MAX_OFFSET, LAST_OFFSET);
  380.     /* GBSL: check that MAX_OFFSET and SFP_SIZE in bytes, else need to adjust*/
  381.     gen_ic(I_DATA, MAX_OFFSET-SFP_SIZE, "size of local objects");/*GBSL*/
  382.     gen(I_END);
  383.  
  384.     /* This subprogram has no parameters... */
  385.  
  386.     if (is_subunit(unit_name)) {
  387.         si = stub_numbered(unit_name); /* get stub index */
  388.         stub_tup = (Tuple) stub_info[si];
  389.         ev = (Stubenv) stub_tup[2];
  390.         ev->ev_relay_set = RELAY_SET; /* see if copy needed below*/
  391.         /*STUB_ENV(unit_name)(8) = RELAY_SET;*/
  392.         /*STUB_ENV(unit_name)(9) = DANGLING_RELAY_SETS;*/
  393.         ev->ev_dangling_relay_set  = DANGLING_RELAY_SETS;
  394.     }
  395.     else if (tup_size(RELAY_SET) != 0 || tup_size(DANGLING_RELAY_SETS) != 0) {
  396.         chaos("Relay set at level 1");
  397.     }
  398.  
  399.     /* Remaining elements in SUBPROG_PATCH are procedures declared in a */
  400.     /* package spec whose body is separate. Generate corresponding */
  401.     /* procedure templates. Those templates must be declared as */
  402.     /* generated objects, as they will be referenced by other units. */
  403.     /* Information in symbol tables is irrelevant, and left as OM. */
  404.  
  405.     n = tup_size(SUBPROG_PATCH);
  406.     /*loop forall patch_addr = SUBPROG_PATCH(name) do*/
  407.     for (i = 1; i <= n; i+=2) {
  408.         name = (Symbol) SUBPROG_PATCH[i];
  409.         patch_addr = (unsigned int) SUBPROG_PATCH[i+1];
  410.         temp_name = new_unique_name("proc_template"); /* associated name */
  411.         assoc_symbol_put(name, PROC_TEMPLATE, temp_name);
  412.         generate_object(temp_name);
  413.         stub_cs = select_entry(SELECT_CODE, name, SLOTS_CODE_BORROWED);
  414.         stemplate = template_new(TT_SUBPROG, -1, WORDS_SUBPROG, (int **)&tptr);
  415.         tptr->cs = stub_cs;
  416.         tptr->relay_slot = stub_cs; /* relay_slot */
  417.         next_global_reference_template(temp_name, stemplate);
  418.         segment_free(stemplate);
  419.         reference_of(temp_name);
  420.         segment_set_pos(CODE_SEGMENT, patch_addr, 0);
  421.         segment_put_ref(CODE_SEGMENT, REFERENCE_SEGMENT, (int)REFERENCE_OFFSET);
  422.         segment_set_pos(CODE_SEGMENT, 0, 2); /* reposition to end */
  423.     }
  424.  
  425.     CODE_SEGMENT_MAP = segment_map_put(CODE_SEGMENT_MAP, CURRENT_CODE_SEGMENT,
  426.       CODE_SEGMENT);
  427.  
  428. #ifdef MACHINE_CODE
  429.     if (list_code) {
  430.         to_gen(" ");
  431.         to_gen(" --- Local reference map :");
  432.         to_gen_int("       Parameter offset = ", MAX_OFFSET);
  433.         print_ref_map_local();
  434.     }
  435. #endif
  436. #ifdef MONITOR
  437.     *MON_PACKAGE_NAME = '\0';
  438. #endif
  439. }
  440.